00100	COMMENT ⊗   VALID 00006 PAGES 
00200	RECORD PAGE   DESCRIPTION
00300	 00001 00001
00400	 00002 00002	First, here is what's left of the file TAILOR
00500	 00003 00003	START AT UPWRT
00600	 00005 00004	
00700	 00009 00005	SMTAB:	XWD	2,0		BLOCK TYPE (SYMBOLS)
00800	 00010 00006	
00900	 00011 ENDMK
01000	⊗;
     

00100	;First, here is what's left of the file TAILOR
00200	INTERN SLOF,LOCSM
00300	
00400	SLOF:	SLOFIL
00500		SIXBIT	/REL/
00600		0↔0			;FOR LOW SEGMENT MODIFICATION
00700	
00800	LOCSM:	LOCSYM			;TAILORS UP.FAI ROUTINES
00900	
01000	;Next, UP.FAI, half TENEXized.
01100	?SEGS←←1
01200	?LOWER←←0
01300	?UPPER←←1
01400	?RENSW←←0			;NOT FOR MAKING A TENEX SEGMENT
01500	IFNDEF GLOBSW,<↓GLOBSW←←0>
01600		TITLE UPPER
01700	BEGIN UPPER1
01800	
01900	A←←1
02000	B←←2
02100	C←←3
02200	D←←4
02300	E←←5
02400	
     

00100	;START AT UPWRT
00200	
00300	EXTERNAL JOBSYM
00400	
00500	
00600	↑UPWRT:	JSYS 	RESET
00700	UPGOT:	SETZM	FIRLOC+11	;NO 2D SEGMENT SYMBOL TABLE
00800		HRRZ	A,JOBSYM	;DELETE SYMBOL TABLE
00900		MOVEI	A,-FIRLOC-1(A)
01000		HRRZM	A,ASIZ		;SIZE OF SEC. SEG. -1
01100		ADDI	A,SEGPAG*1000	;COMPUTE TOP OF SEGMENT
01200		HRRZM	A,FIRLOC+12	;TOP2 WORD.....
01300	
01400	;FIRST BLT THE SEGMENT INTO PLACE
01500	;THEN SAVE IT AWAY WITH SSAVE
01600		MOVE A,[XWD FIRLOC,SEGPAG*1000]
01700		MOVE B, [BLT A ,]
01800		HRR	B,FIRLOC+12	;TOP2 WORD, COMPUTED ABOVE
01900		XCT B
02000	;RESET ENTRY VECTOR
02100		MOVEI	A,400000	;THIS FORK
02200		MOVE	B,[JRST 400010]	;ENTRY VECTOR INDICATING JOBSA FOR START
02300		JSYS	SEVEC		;SET IT
02400		  JFCL			;ERROR??
02500	GTSEG:	HRROI	A,[ASCIZ/
02600	Type name for segment file,
02700	assembled name is /]
02800		JSYS	PSOUT
02900		HRROI	A,[FILXXX]
03000		JSYS	PSOUT
03100		HRROI	A,[ASCIZ/
03200	*/]
03300		JSYS	PSOUT
03400		HRLZI A,400003
03500		MOVE	B,[XWD 100,101]	;PRIMARY INPUT-OUTPUT
03600		JSYS GTJFN
03700		  JRST	[HRROI	A,[ASCIZ/
03800	Can't GTJFN segment file, try again.
03900	/]
04000			 JSYS 	PSOUT
04100			 JRST GTSEG]
04200		HRLI 1,400000		;THIS FORK
04300		MOVE 2,[XWD -50,520000+SEGPAG]
04400		SETZ 3,
04500		JSYS SSAVE
04600		JSYS RLJFN
04700		  JRST [HRROI	A,[ASCIZ/
04800	Cant RLJFN segment.
04900	/]
05000			JSYS	PSOUT
05100			JSYS HALTF]
     

00100	COMMENT ⊗
00200	 THE INTERNAL SYMBOLS FROM THIS UPPER SEGMENT WILL NOW BE
00300	COPIED INTO THE LOWER SEGMENT .REL FILE, TO PROVIDE UPPER/LOWER
00400	LINKAGES.  THIS ELIMINATES THE NEED FOR THE LOADER TO KNOW ANYTHING 
00500	ABOUT STRANGE SAIL UPPER SEGMENTS
00600	⊗
00700	
00800		INIT	1,14		;INPUT
00900		'DSK   '
01000		IBUF
01100		JRST	[	PRINT	<NO DISK TODAY>
01200				JSYS HALTF]
01300		SETZM	SLOF1+2
01400		SETZM	SLOF1+3
01500		LOOKUP	1,SLOF1		;GET SAILOW.REL OR SOMETHING
01600		JRST	[PRINT	<WHERE IS LOWER?>
01700			JSYS HALTF]
01800	
01900		INIT	2,14		;OUTPUT
02000		'DSK   '
02100		XWD	OBUF,0
02200		JRST	[PRINT	<NO DISK TODAY>
02300			JSYS HALTF]
02400		SETZM	SLOF+2
02500		SETZM	SLOF+3
02600		ENTER	2,SLOF		;PUT SAME
02700		JRST	[PRINT	<CAN'T MAKE NEW SAILOW>
02800			JSYS HALTF]
02900		HLRE	3,JOBSYM
03000		MOVMS	3
03100		HRRZ	2,JOBSYM
03200		ADD	2,3		;→PAST END OF SYMBOL TABLE
03300		HRRZM	2,JOBFF		;IF NO DDT, LOADER HAS WIPED SYMTAB
03400		INBUF	1,2
03500		OUTBUF	2,2
03600		HLLZS	SMTAB		;SOME INITIALIZATION (NOT MUCH)
03700	FOR II←1,4 <
03800		JSP	1,COPY		;COPY FIRST FOUR WORDS (NAME BLOCK)
03900	>
04000		LSH	3,-1		;#SYMBOLS
04100		MOVE	TEMP,[RADIX50 0,UPPER] ;LOOK FOR THIS PROGRAM
04200	LP1:	CAMN	TEMP,(2)
04300		JRST	LOOP
04400		SUBI	2,2
04500		SOJG	3,LP1
04600		HALT			;DIDN'T FIND IT
04700	LOOP:	SUBI	2,2		;BACK UP ONE ENTRY
04800		JSP	6,COPSYM	;COPY ONE ENTRY IF INTERNAL
04900		SOJG	3,LOOP		;GET ALL OF THEM
05000		JSP	6,FORSYM	;FORCE REMAINING OUT
05100		JSP	1,COPY		;COPY REST OF FILE
05200		JRST	.-1		;WILL NOT RETURN ON EOF
05300	
05400	COPY:	SOSLE	IBUF+2		;INPUT ROUTINE
05500		JRST	OKIN
05600		INPUT	1,0		;SURELY YOU'VE SEEN THESE BEFORE?
05700		STATZ	1,20000		;EOF?
05800		CALLI	12		;YES, DONE
05900		STATZ	1,740000	;ERROR?
06000		JRST	[PRINT	<INPUT DATA ERROR IN SAILOW UPDATE>
06100			JSYS HALTF]
06200	OKIN:	ILDB	4,IBUF+1	;GET ONE
06300	OUTWD:	SOSG	OBUF+2		;OUTPUT ROUTINE
06400		OUTPUT	2,
06500		IDPB	4,OBUF+1
06600		JRST	(1)
06700	
06800	COPSYM:	LDB	4,[POINT 4,(2),3] ;SYMBOL TYPE
06900		JUMPE	4,1(6)		;ANOTHER PROG, QUIT
07000		SKIPE	LOCSM		;LOAD ALL IF LOCAL SYMBOLS WANTED
07100		 JRST	 ALLTHM
07200		CAIE	4,1		;INTERNAL?
07300		JRST	(6)		;NO
07400		HRRZ	4,1(2)
07500		CAIGE	4,400000	;SECOND SEGMENT SYMBOL?
07600		JRST	(6)		;NO AGAIN
07700	ALLTHM:	AOS	SMTAB		;MAKE ROOM FOR 2
07800		AOS	5,SMTAB
07900		HRRZS	5		;INDEX TO SYMBOL BLOCK
08000		MOVE	4,(2)
08100		MOVEM	4,SMTAB(5)
08200		MOVE	4,1(2)		;MAKE THE TRANSFERS
08300		MOVEM	4,SMTAB+1(5)
08400		CAIGE	5,22		;FULL?
08500		JRST	(6)		;NO, DONE
08600	FORSYM:	HRRZ	5,SMTAB		;GET COUNT
08700		JUMPE	5,(6)		;RETURN IF EMPTY
08800		MOVNI	5,2(5)		;FOR BLOCK TYPE AND RELOC WORDS
08900		HRLS	5		;AOBJN PTR
09000		HRRI	5,SMTAB
09100	OLP:	MOVE	4,(5)		;WORD TO GO OUT
09200		JSP	1,OUTWD		;OUT IT GOES
09300		AOBJN	5,OLP		;GET ALL
09400		HLLZS	SMTAB
09500		JRST	(6)		;THAT'S ALL
     

00100	SMTAB:	XWD	2,0		;BLOCK TYPE (SYMBOLS)
00200		0			;NEVER RELOCATE THESE
00300		BLOCK	22		;ROOM FOR SYMBOLS
00400	
00500	IBUF:	BLOCK	3
00600	OBUF:	BLOCK	3
00700	
00800	SLOF1:	SIXBIT	/LOWER/		;ALWAYS
00900		SIXBIT	/REL/		;LOWER FOR INPUT
01000		0↔0
01100	
01200	DUMPR:	BLOCK	2
01300		ASIZ:	0
01400		AONE:	XWD FIRLOC,SEGPAG*1000
01500	
01600		LIT
01700	FIRLOC:
01800	
01900	BEND UPPER1
02000	↓%FIRLOC:
02100	PHASE SEGPAG*1000	;MAGIC ....
02200		0		;400000 (OR WHATEVER FOR TENEX)
02300	REPEAT 10,<-1>
02400		0		;400011 -- JOBSYM POINTER.
02500	↓TOP2:	0		;400012 -- TOP SEC SEG ADDRESS.
02600	
02700	INTERNAL %ALLOC
     

00100	
00200	
00300	
00400